home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / diskmags / 4671-5.790 / dmg-5786 / fastlife / fasterli.bas next >
BASIC Source File  |  1990-05-08  |  6KB  |  198 lines
  1. ' LIFE (C) Peter Augustin September 1989
  2. DEFINT a-z
  3. CONST LEFT=1,RIGHT=2,MINUSONE=-1,ONE=1,TWO=2,THREE=3
  4. OPTION BASE 0
  5. CHRGAPY=TWO:CHRGAPX=TWO
  6. SETSCREEN X,Y,GENPOS,HE,GAPY,GAPX,CHRGAPY,CHRGAPX
  7. DIM CELLSTATE(Y+ONE,X+ONE),CELLCOUNT(Y+ONE,X+ONE),WORKCOUNT(Y+ONE,X+ONE)
  8. CALL CONFIGURATION(X,Y)
  9. CALL HARDWAY(X,Y)
  10. DO
  11.   READMOUSE XPOS,YPOS,BUTTON
  12.   IF BUTTON=RIGHT THEN CALL GETICONS(X,Y)
  13.   CALL GENERATION(X,Y,GENPOS)
  14. LOOP UNTIL BUTTON=THREE
  15. STOP
  16. SUB HARDWAY(VAL X,VAL Y)
  17.     SHARED CELLSTATE(),CELLCOUNT(),WORKCOUNT()
  18.     FOR I=ONE TO Y
  19.      FOR J=ONE TO X
  20.       T=0
  21.       FOR K=MINUSONE TO ONE
  22.        FOR L=MINUSONE TO ONE
  23.         T=T+CELLSTATE(I+K,J+L)
  24.       NEXT L,K
  25.       CELLCOUNT(I,J)=T-CELLSTATE(I,J)
  26.       WORKCOUNT(I,J)=CELLCOUNT(I,J)
  27.       CALL DISPLAY(I,J,CELLSTATE(I,J))
  28.     NEXT J,I
  29. END SUB
  30. SUB DISPLAY(VAL I,VAL J,VAL STATE)
  31.     SHARED CHRGAPY,CHRGAPX
  32.     LOCATE (I+CHRGAPY),(J+CHRGAPX),0
  33.     COLOR 3
  34.     IF STATE=0 THEN
  35.      PRINT CHR$(43);
  36.      ELSE COLOR 2:PRINT CHR$(6);
  37.     END IF
  38. END SUB
  39. SUB GENERATION(VAL X,VAL Y,VAL GENPOS)
  40.     SHARED CELLSTATE(),CELLCOUNT(),WORKCOUNT(),GEN
  41.     FOR I=ONE TO Y
  42.      FOR J=ONE TO X
  43.       IF CELLCOUNT(I,J)=THREE AND CELLSTATE(I,J)=0 THEN CALL BORN(I,J)
  44.       IF (CELLCOUNT(I,J)<TWO OR CELLCOUNT(I,J)>THREE) AND CELLSTATE(I,J)=ONE THEN CALL DIES(I,J)
  45.     NEXT J,I
  46.     FOR I=ONE TO Y
  47.      FOR J=ONE TO X
  48.       CELLCOUNT(I,J)=WORKCOUNT(I,J)
  49.     NEXT J,I
  50.     INCR GEN 
  51.     COLOR 1:LOCATE 1,GENPOS,0 :PRINT USING "#####"; GEN
  52. END SUB
  53. SUB BORN(VAL I,VAL J)
  54.     SHARED WORKCOUNT(),CELLSTATE(),CHRGAPY,CHRGAPX
  55.     CELLSTATE(I,J)=ONE
  56.     FOR K=MINUSONE TO ONE
  57.      FOR L=MINUSONE TO ONE
  58.       INCR WORKCOUNT(I+K,J+L)
  59.     NEXT L,K
  60.     DECR WORKCOUNT(I,J)
  61.     COLOR 2:LOCATE (I+CHRGAPY),(J+CHRGAPX):PRINT CHR$(6);
  62. END SUB 
  63. SUB DIES(VAL I,VAL J)
  64.     SHARED WORKCOUNT(),CELLSTATE(),CHRGAPY,CHRGAPX
  65.     CELLSTATE(I,J)=0
  66.     FOR K=MINUSONE TO ONE
  67.      FOR L=MINUSONE TO ONE
  68.       DECR WORKCOUNT(I+K,J+L)
  69.     NEXT L,K
  70.     INCR WORKCOUNT(I,J)
  71.     COLOR 3:LOCATE (I+CHRGAPY),(J+CHRGAPX):PRINT CHR$(43);
  72. END SUB
  73. SUB READMOUSE(XPOS,YPOS,BUTTON)
  74.     XPOS=MOUSE(0)
  75.     YPOS=MOUSE(1)
  76.     BUTTON=MOUSE(2) 
  77. END SUB
  78. SUB GETICONS(VAL X,VAL Y)
  79.     SHARED GAPY,HE,GENPOS,GEN
  80.     MOUSE 0
  81.     DO
  82.       DO
  83.         READMOUSE XPOS,YPOS,BUTTON
  84.         SC=YPOS
  85.         SELECT CASE SC
  86.                CASE 0 TO 9 :ICONBAR XPOS,CODENUM
  87.                CASE GAPY+3 TO (Y*HE)+GAPY+2:IF XPOS>=16 AND XPOS<=(X*8)+15 THEN
  88.                CELLGRID XPOS,YPOS,XCELL,YCELL,CELL,CODENUM:MOUSE -1
  89.                ELSE MOUSE 0'numbers
  90.                END IF
  91.                CASE ELSE CODENUM=0:MOUSE 0
  92.         END SELECT
  93.       LOOP UNTIL BUTTON=LEFT AND CODENUM<>0
  94.       SELECT CASE CODENUM
  95.              CASE ONE :CALL RCELLGRID (XCELL,YCELL,CELL,CODENUM)
  96.              CASE TWO :CALL RCLEAR(CODENUM)
  97.              CASE THREE:CALL RGEN(CODENUM)
  98.       END SELECT
  99.     LOOP UNTIL CODENUM=99           
  100.     MOUSE -1
  101. END SUB
  102. SUB SETSCREEN (X,Y,GENPOS,HE,GAPY,GAPX,CHRGAPY,CHRGAPX)
  103.     GRAPHMOD=PEEKW(SYSTAB)
  104.     SELECT CASE GRAPHMOD
  105.            CASE=4
  106.            Y=19:X=36:GENPOS=35:SIZE=TWO:HEIGHT=2 'LOW RES
  107.            CASE=2
  108.            Y=19:X=76:GENPOS=70:SIZE=ONE:HEIGHT=2 'MED RES
  109.            CASE=1
  110.            Y=19:X=76:GENPOS=70:SIZE=ONE:HEIGHT=1 'HIGH RES
  111.     END SELECT 
  112.     MOUSE -1
  113.     HE=18/HEIGHT:GAPY=CHRGAPY*HE:GAPX=CHRGAPX*8
  114.     WINDOW OPEN 2,"",0,0,640/SIZE,400/HEIGHT,0
  115.     COLOR 1,1,1,4,2
  116.     'BOX CELL GRID
  117.     LINEF 0,10,640/SIZE,10'FINISH WINDOW
  118.     LINEF GAPX-TWO,GAPY,(8*X)+GAPX+TWO,GAPY
  119.     LINEF GAPX-TWO,GAPY,GAPX-TWO,(HE*Y)+GAPY+TWO
  120.     LINEF (8*X)+GAPX+TWO,GAPY,(8*X)+GAPX+TWO,(HE*Y)+GAPY+TWO
  121.     LINEF GAPX-TWO,(HE*Y)+GAPY+TWO,(8*X)+GAPX+TWO,(HE*Y)+GAPY+TWO
  122.     FILL 0,11
  123.     LOCATE 1,3,0:PRINT"  CLEAR  START  "
  124.     COLOR 1:LOCATE 1,GENPOS,0 :PRINT USING "#####"; GEN
  125. END SUB
  126. SUB CONFIGURATION(VAL X,VAL Y)
  127.     SHARED CELLSTATE()
  128.     C=Y+ONE:D=X+ONE
  129.     FOR I=ONE TO Y
  130.      CELLSTATE(I,I)=ONE
  131.      CELLSTATE(C-I,I)=ONE
  132.      CELLSTATE(I,D-I)=ONE
  133.      CELLSTATE(C-I,D-I)=ONE
  134.     NEXT I
  135. END SUB
  136. SUB ICONBAR(VAL XPOS,CODENUM)
  137.     SHARED GENPOS,GEN
  138.     STATIC COPYXCHR
  139.     XCHR=INT(XPOS/8)+1
  140.     IF COPYXCHR=XCHR THEN EXIT SUB
  141.     LOCATE 1,3,0:PRINT"  CLEAR  START  "
  142.     LOCATE 1,GENPOS,0:PRINT USING"#####";GEN
  143.     COLOR 2
  144.     SELECT CASE XCHR
  145.            CASE 4 TO 10:
  146.            LOCATE 1,4,0:PRINT "|CLEAR|":CODENUM=2
  147.            CASE 11 TO 18:LOCATE 1,11,0:PRINT "|START|":CODENUM=99
  148.            CASE GENPOS TO GENPOS+5:LOCATE 1,GENPOS,0:PRINT USING"#####";GEN:CODENUM=3
  149.            CASE ELSE :CODENUM=0
  150.     END SELECT
  151.     COLOR 1
  152.     COPYXCHR=XCHR
  153. END SUB
  154. SUB RCLEAR(CODENUM)
  155.     SHARED CELLSTATE(),WORKCOUNT(),CELLCOUNT(),X,Y,CHRGAPY,CHRGAPX
  156.     FOR I=ONE TO Y
  157.      FOR J=ONE TO X
  158.       IF WORKCOUNT(I,J)>0 THEN WORKCOUNT(I,J)=0:COLOR 3:LOCATE (I+CHRGAPY),(CHRGAPX+J):PRINT CHR$(43);
  159.       CELLSTATE(I,J)=0
  160.       CELLCOUNT(I,J)=WORKCOUNT(I,J)
  161.     NEXT J,I
  162.     CODENUM=0
  163. END SUB
  164. SUB RGEN(CODENUM)
  165.     SHARED GEN,GENPOS
  166.     GEN=0
  167.     LOCATE 1,GENPOS,0:PRINT USING "#####";GEN
  168.     CODENUM=0
  169. END SUB
  170. SUB CELLGRID(VAL XPOS,VAL YPOS,XCELL,YCELL,CELL,CODENUM)
  171.     SHARED CELLSTATE(),CHRGAPY,CHRGAPX,GAPY,HE
  172.     STATIC COPYX,COPYY,CELL,CODENUM
  173.     XCELL=INT((XPOS-16)/8)+1:YCELL=INT((YPOS-(GAPY+3))/HE)+1
  174.     IF XCELL=COPYX AND YCELL=COPYY THEN EXIT SUB
  175.     IF COPYX<=0 THEN GOTO JUMP
  176.     LOCATE (COPYY+CHRGAPY),(COPYX+CHRGAPX),0
  177.     COPYCELL=CELLSTATE(COPYY,COPYX)
  178.     IF COPYCELL=0 THEN COLOR 3:PRINT CHR$(43); ELSE COLOR 2:PRINT CHR$(6);
  179.     JUMP:
  180.     LOCATE (YCELL+CHRGAPY),(XCELL+CHRGAPX),0
  181.     CELL=CELLSTATE(YCELL,XCELL)
  182.     IF CELL=0 THEN COLOR 3:PRINT CHR$(189); ELSE COLOR 2:PRINT CHR$(189);
  183.     COPYX=XCELL:COPYY=YCELL:CODENUM=1
  184.     COLOR 1
  185. END SUB
  186. SUB RCELLGRID(VAL XCELL,VAL YCELL,VAL CELL,CODENUM)
  187.     SHARED WORKCOUNT(),CELLCOUNT()
  188.     IF CELL=0 THEN
  189.     CALL BORN(YCELL,XCELL)
  190.     ELSE CALL DIES(YCELL,XCELL)
  191.     END IF
  192.     FOR K=MINUSONE TO ONE
  193.      FOR L=MINUSONE TO ONE
  194.       CELLCOUNT(YCELL+K,XCELL+L)=WORKCOUNT(YCELL+K,XCELL+L)
  195.     NEXT L,K
  196.     CODENUM=0
  197. END SUB
  198.